home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8506.arc / SIEVE.COB < prev    next >
Text File  |  1986-09-14  |  3KB  |  83 lines
  1.        IDENTIFICATION DIVISION.
  2.       *
  3.       *    SIEVE OF ERATOSTHENES
  4.       *    BYTE MAGAZINE HIGH-LEVEL LANGUAGE BENCHMARK
  5.       *    JANUARY 1983 BYTE, PAGE 283
  6.       *
  7.        PROGRAM-ID. SIEVE.
  8.        ENVIRONMENT DIVISION.
  9.        CONFIGURATION SECTION.
  10.        SOURCE-COMPUTER.         IBM-PC.
  11.        OBJECT-COMPUTER.         IBM-PC.
  12.       *
  13.        DATA DIVISION.
  14.        WORKING-STORAGE SECTION.
  15.  
  16.       * FOR DECIMAL VERSION, USAGE IS COMP-3.
  17.       * FOR BINARY, USAGE COMP-1 FOR RMCOBOL, COMP-4 FOR REALIA.
  18.  
  19.        01  MISC.
  20.            05  I             PIC 9(4) COMP-3.
  21.            05  K             PIC 9(5) COMP-3.
  22.            05  PRIME-COUNT   PIC 9(4) COMP-3.
  23.            05  PRIME         PIC 9(5) COMP-3.
  24.            05  INPUT-COUNT   PIC 99999.
  25.            05  ITER-COUNT    PIC 9(4) COMP-3.
  26.            05  PRIME-DISP    PIC 9(4).
  27.       *
  28.        01  FLAG-AREA.
  29.            05  FLAGS         PIC X OCCURS 8191 TIMES.
  30.       *
  31.       * COPY TIMERDAT for Realia, COPY "TIMERDAT.CBL" for RMC
  32.            COPY TIMERDAT.
  33.       *
  34.       *
  35.        PROCEDURE DIVISION.
  36.        DISPLAY-MESSAGE.
  37.            DISPLAY "Sieve of Eratosthenes prime number routine.".
  38.            DISPLAY " ".
  39.            PERFORM 100-GET-COUNT THRU 100-EXIT
  40.              UNTIL INPUT-COUNT NUMERIC.
  41.            MOVE INPUT-COUNT TO ITER-COUNT.
  42.       *
  43.        TESTING-MODULE.
  44.            ACCEPT TIMER-START FROM TIME.
  45.            PERFORM ITERATION-ROUTINE ITER-COUNT TIMES.
  46.            ACCEPT TIMER-END FROM TIME.
  47.            PERFORM 2400-CALC-TIME THRU 2400-EXIT.
  48.            DISPLAY ELAPSED-TIME.
  49.            STOP RUN.
  50.       *
  51.        ITERATION-ROUTINE.
  52.            MOVE ZERO TO PRIME-COUNT.
  53.            PERFORM TABLE-FILL-ROUTINE VARYING I FROM 1 BY 1
  54.                   UNTIL I = 8191.
  55.            PERFORM COMPARE-ROUTINE THRU COMPARE-EXIT VARYING I
  56.                   FROM 1 BY 1 UNTIL I = 8191.
  57.       *
  58.        TABLE-FILL-ROUTINE.
  59.            MOVE "1" TO FLAGS (I).
  60.       *
  61.        COMPARE-ROUTINE.
  62.            IF FLAGS (I) = "0" GO TO COMPARE-EXIT.
  63.            COMPUTE PRIME = I + I + 1.
  64.            COMPUTE K = I + PRIME.
  65.            PERFORM STRIKOUT UNTIL K > 8191.
  66.            ADD 1 TO PRIME-COUNT.
  67.       *
  68.        COMPARE-EXIT.
  69.            EXIT.
  70.       *
  71.        STRIKOUT.
  72.            MOVE "0" TO FLAGS (K).
  73.            ADD PRIME TO K.
  74.       *
  75.  
  76.        100-GET-COUNT.
  77.            DISPLAY "Enter iteration count 1-100".
  78.            ACCEPT INPUT-COUNT.
  79.        100-EXIT.   EXIT.
  80.  
  81.       * COPY TIMERPRO for Realia, COPY "TIMERPRO.CBL" for RMC
  82.            COPY TIMERPRO.
  83.